home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr13 / golisp.zip / SS.LSP < prev    next >
Lisp/Scheme  |  1995-01-20  |  1KB  |  40 lines
  1. ;Stretch command
  2. ;Bob Zelna
  3.  
  4. (command ".UNDEFINE" "STRETCH")
  5. (defun C:SS (/ pt1 pt2 ss0 ss1 ss2 ename index echo)
  6.   (setq echo (getvar "cmdecho"))
  7.   (setvar "cmdecho" 0)
  8.   (if (and (setq pt1 (getpoint "\nFirst corner:")
  9.                  pt2 (getcorner pt1 "\nOpposite corner:")
  10.                  ss1 (ssget "C" pt1 pt2)
  11.            )
  12.       )
  13.     (progn
  14.       (prompt "\nAdd or Remove objects...")
  15.       (command ".SELECT" ss1 pause)
  16.       (setq ss0 (ssget "P")
  17.             ss2 (ssadd)
  18.             index -1
  19.       )
  20.       (while (setq ename (ssname ss1 (setq index (1+ index))))
  21.         (if (null (ssmemb ename ss0))
  22.           (ssadd ename ss2)
  23.         )
  24.       )
  25.       (setq ename (ssname ss2 0))
  26.       (princ "\nBase point:")
  27.       (apply 'Command
  28.         (append
  29.           (if ename (list ".SELECT" ss2 ""))
  30.           (list ".STRETCH" "C" pt1 pt2)
  31.           (if ename (list "R" "P"))
  32.           (list "" pause)
  33.         )
  34.       )
  35.     )
  36.   )
  37.   (setvar "cmdecho" echo)
  38.   (princ)
  39. )
  40.